perm filename INIT.SAI[PNT,HE] blob
sn#572764 filedate 1981-03-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 PROCEDURE INISCANNER
C00018 00004 ! initialization procedure : INIT,INIT0
C00020 00005 ! preswap,postswap
C00023 00006 ! exit procedure: endit
C00025 ENDMK
C⊗;
ENTRY;
BEGIN "INIT"
DEFINE $INIT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
STRING $USERNAME,$ALIAS_ID,$LOGIN_ID,$ALIAS_PPN,$LOGIN_PPN;
PROCEDURE INISCANNER;
BEGIN
ARRCLR($ENTRY);
STOKEN←FALSE;
$TTYFL←NULL;
$ALFL←"DECLAR.AL"; ! default name for input/output file;
$EPS←0.001;
DEVICE←TTY_X; ! input is from teletype;
TTYUP(TRUE); ! all input from teletype to be converted to UPPER case;
END;
PROCEDURE INIOFFSET;
BEGIN
ARRCLR(OFFSET); ! clear data array of offsets;
ALEVENTOFF←'400;
ARROFF[#SC]←'401;
ARROFF[#VT]←'402;
ARROFF[#RT]←ARROFF[#TR]←ARROFF[#FR]←'403;
ARROFF[#EV]←'404; ! ATTENTION;
ARROFF[#ST]←'405;
$SYMOFF←'406; ! ATTENTION: CHECK RUNTIME;
END;
PROCEDURE INIDIMENS;
BEGIN DIMENS:FORCE[FORCE_DIMENS←NEW_RECORD(DIMENS)]←1;
DIMENS:TIME[TIME_DIMENS←NEW_RECORD(DIMENS)]←1;
DIMENS:DISTANCE[DISTANCE_DIMENS←NEW_RECORD(DIMENS)]←1;
DIMENS:ANGLE[ANGLE_DIMENS←NEW_RECORD(DIMENS)]←1;
TORQUE_DIMENS←MULT_DIMENS(FORCE_DIMENS,DISTANCE_DIMENS);
VELOCITY_DIMENS←DIVIDE_DIMENS(DISTANCE_DIMENS,TIME_DIMENS);
NIL_DIMENS←NEW_RECORD(DIMENS);
DIMENS:SYM[FORCE_DIMENS]←ENSYM("FORCE",#DM,FORCE_DIMENS);
DIMENS:SYM[TIME_DIMENS]←ENSYM("TIME",#DM,TIME_DIMENS);
DIMENS:SYM[DISTANCE_DIMENS]←ENSYM("DISTANCE",#DM,DISTANCE_DIMENS);
DIMENS:SYM[ANGLE_DIMENS]←ENSYM("ANGLE",#DM,ANGLE_DIMENS);
DIMENS:SYM[TORQUE_DIMENS]←ENSYM("TORQUE",#DM,TORQUE_DIMENS);
DIMENS:SYM[VELOCITY_DIMENS]←ENSYM("VELOCITY",#DM,VELOCITY_DIMENS);
DIMENS:SYM[NIL_DIMENS]← ENSYM("DIMENSIONLESS",#DM,NIL_DIMENS);
END;
PROCEDURE TMPOFFSET;
BEGIN
! make 9 new scalars because 10th is already made in AL;
RPTR(EXPR$)S1,S2;
$TSCOFF←$SYMOFF;
$TTROFF←$SYMOFF+10;
$SYMOFF←$TTROFF+10;
S1←$SMPDCLPCODE(#SC,9);
S2←$SMPDCLPCODE(#TR,10);
$EXECUTE($APPEND(S1,S2));
END;
PROCEDURE INIWORLD;
BEGIN
WORLD←ENSYM("STATION",#FR,F_WRLD←MK_REC(#FR));
FRAME:PNAME[F_WRLD]←"STATION";
END;
PROCEDURE SETOFFSET(INTEGER INDEX);
BEGIN
INTEGER I;
IF INDEX≠CON_OFFSET AND INDEX≠PRG_OFFSET THEN OUTSTR("error in SETOFFSET")
ELSE FOR I←#MIN STEP 1 UNTIL #MAX
DO OFFSET[INDEX,I]←OFFSET[CUR_OFFSET,I];
END;
PROCEDURE SAVRESOFFSET;
BEGIN
INTEGER I;
FOR I←#MIN STEP 1 UNTIL #MAX DO OFFSET[RES_OFFSET,I]←$ENTRY[I];
OFFSET[RES_OFFSET,#DM]←$ENTRY[#DM];
END;
PROCEDURE GTARMOFFSET;
BEGIN
PROCEDURE FORCESYMBOL(RPTR(SYMBOL)S; INTEGER OFF);
BEGIN SYMBOL:OFFSET[S]←OFF; SYMBOL:INDEX[S]←0; END;
INTEGER I,NILROTOFF,NILTRANSOFF;
RPTR(SYMBOL)TEMP;
ASKUSER("___ENDASKUSER");
GTOKEN;
WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
BEGIN
STOKEN←TRUE;
PARSE;
GTOKEN;
END;
FORCESYMBOL(HANDY←CHECK("YHAND",#SC),YHD_ALOFFSET);
FORCESYMBOL(HANDB←CHECK("BHAND",#SC),BHD_ALOFFSET);
FORCESYMBOL(YARM←CHECK("YARM",#FR), YRM_ALOFFSET);
FORCESYMBOL(BARM←CHECK("BARM",#FR), BRM_ALOFFSET);
FORCESYMBOL(HANDG←CHECK("GHAND",#SC),GHD_ALOFFSET);
FORCESYMBOL(HANDR←CHECK("RHAND",#SC),RHD_ALOFFSET);
FORCESYMBOL(GARM←CHECK("GARM",#FR), GRM_ALOFFSET);
FORCESYMBOL(RARM←CHECK("RARM",#FR), RRM_ALOFFSET);
FORCESYMBOL(CHECK("BARM_ERROR",#SC),BARM_ERROR_ALOFFSET);
FORCESYMBOL(CHECK("YARM_ERROR",#SC),YARM_ERROR_ALOFFSET);
FORCESYMBOL(CHECK("YHAND_ERROR",#SC),YHAND_ERROR_ALOFFSET);
FORCESYMBOL(CHECK("BHAND_ERROR",#SC),BHAND_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("VISE_ERROR",#SC),VISE_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("DRIVER_ERROR",#SC),DRIVER_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("GARM_ERROR",#SC),GARM_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("RARM_ERROR",#SC),RARM_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("GHAND_ERROR",#SC),GHAND_ERROR_ALOFFSET);
! FORCESYMBOL(CHECK("RHAND_ERROR",#SC),RHAND_ERROR_ALOFFSET);
NILROTOFF←SYMBOL:INDEX[CHECK("NILROT",#RT)];
NILTRANSOFF←SYMBOL:INDEX[CHECK("NILTRANS",#TR)];
OFFSET[ARM_OFFSET,#SC]←OFFSET[CUR_OFFSET,#SC];
OFFSET[ARM_OFFSET,#VT]←OFFSET[CUR_OFFSET,#VT];
OFFSET[ARM_OFFSET,#RT]←NILROTOFF;
OFFSET[ARM_OFFSET,#TR]←NILTRANSOFF;
OFFSET[ARM_OFFSET,#FR]←OFFSET[CUR_OFFSET,#FR];
ASKUSER("AFFIX BGRASP TO BARM AT TRANS(ROT(XHAT,-180*DEG),NILVECT*INCHES); ___ENDASKUSER");
GTOKEN;
WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
BEGIN
STOKEN←TRUE;
PARSE;
GTOKEN;
END;
MTYDEVSTACK;
END;
PROCEDURE INIERRCODES;
$EXECUTE($ERRPCODE);
PROCEDURE INIBRK;
BEGIN
STRING BTABLE,LETDIGS;
BTABLE←"¬#:<>≤≥≡≠⊂⊃={}.,;[]()+-*/←↑↓→?α$|⊗"&LF&CR&TAB&FF&SP&dquote;
LETDIGS←"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_";
SETBREAK ($CRTAB ←GETBREAK,CR,LF&FF,"INSK");
SETBREAK ($FFTAB ←GETBREAK,FF,NULL,"INSK");
SETBREAK ($RETAB ←GETBREAK,BTABLE,NULL,"INR"); ! used by gtoken;
SETBREAK ($SKTAB ←GETBREAK,BTABLE,NULL,"INS");
SETBREAK ($SPCTAB←GETBREAK,TAB&SP,NULL, "XNR");
SETBREAK ($ALFTAB←GETBREAK,NULL,NULL,"XRN");
SETBREAK ($NUMTAB←GETBREAK,"@+-0123456789",NULL,"XNR"); ! as table 10;
SETBREAK ($DSHTAB←GETBREAK,"_",NULL,"INS"); ! used by COPY/MERGE;
SETBREAK ($ERRTAB←GETBREAK,BTABLE,SP&CR,"IN"); ! used while recovering;
SETBREAK ($BSKTAB←GETBREAK,NULL,SP,"IN"); ! used to eliminate blanks;
SETBREAK ($DPYTAB←GETBREAK,CR,CRLF,"INS"); ! used for display;
SETBREAK ($LTTAB← GETBREAK,LETDIGS,NULL,"INR");
SETBREAK ($NLTTAB←GETBREAK,LETDIGS,NULL,"XNR");
SETBREAK ($RBTAB← GETBREAK,NULL,RUBOUT,"IN");
$BLANK←" ";
SETFORMAT(0,3);
END;
PROCEDURE INIFILE;
BEGIN "read initialization file"
! check for initialization file on current area, and if absent, get from
[PNT,HE];
STRING FID; BOOLEAN ECHO;
ECHO←FALSE;
FID←"POINTY.INI";
IF FILE_ABSENT(FID) THEN FID←FID&"[PNT,HE]";
READCODE(FID,ECHO);
END;
PROCEDURE INIUSRFILE(STRING FNAME);
BEGIN ! check for initialization file if any;
BOOLEAN FOO;
IF FILE_ABSENT(FNAME) THEN RETURN ELSE READCODE(FNAME,FOO);
END;
PROCEDURE CONSTDATA;
BEGIN
! read in and set up temporary scalars;
ASKUSER("SCALAR "&RUBOUT&"I1, "&RUBOUT&"I2,"&RUBOUT&"I3, "&RUBOUT&"I4, "
&RUBOUT&"I5; ___ENDASKUSER
");
GTOKEN;
SETOFFSET(PRG_OFFSET);
WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
BEGIN
STOKEN←TRUE;
PARSE;
GTOKEN;
END;
MTYDEVSTACK;
INIFILE;
GTOKEN;
WHILE NOT EQU(TOKEN,"_____END____INIT") DO
BEGIN
STOKEN←TRUE;
PARSE;
GTOKEN;
END;
MTYDEVSTACK;
END;
SIMPLE INTEGER PROCEDURE GETHOUR;
RETURN( CALL(0,"TIMER") DIV 216000);
PROCEDURE INIMSG;
BEGIN "Print message of the day"
STRING MESSGE;
INTEGER BRCHAR,CHAN,EOF,FLAG;
INTEGER FFBREAK;
INTEGER HOUR; STRING $HOUR;
IF (HOUR←GETHOUR)<12 THEN $HOUR←"Morning"
ELSE IF HOUR < 17 THEN $HOUR←"Afternoon"
ELSE $HOUR←"Evening";
PRINT("Hello..."&$USERNAME&"...Good "&$HOUR,CRLF);
OPEN(CHAN←GETCHAN,"DSK",0,10,0,1000,BRCHAR,EOF);
LOOKUP(CHAN,"PNTMSG.INI[PNT,HE]",FLAG);
SETBREAK(FFBREAK←GETBREAK,FF,NULL,"ISN");
MESSGE←INPUT(CHAN,FFBREAK);
OUTSTR(MESSGE);
RELEASE(CHAN);
RELBREAK(FFBREAK);
END;
PROCEDURE GETUSERNAME;
α
STRING LINE,WORD,GARB;
INTEGER BRCHAR;
INTEGER RCHAN,RBRCHAR,REOF,RFLAG;
INTEGER CRBREAK,TABBREAK;
STRING ID,ALIAS_NAME,LOGIN_NAME;
ID←CVXSTR(CALL(0,"DSKPPN")); ! look at alias;
$ALIAS_PPN←"["&ID[1 TO 3]&","&($ALIAS_ID←ID[4 TO 6])&"]";
ID←CVXSTR(CALL(0,"GETPPN")); ! look at login ppn;
$LOGIN_PPN←"["&ID[1 TO 3]&","&($LOGIN_ID←ID[4 TO 6])&"]";
OPEN(RCHAN←GETCHAN,"DSK",0,2,0,1000,RBRCHAR,REOF);
LOOKUP(RCHAN,"USERS.DAT[PNT,HE]",RFLAG);
SETBREAK(CRBREAK←GETBREAK,'15,'12&'14,"ISN");
SETBREAK(TABBREAK←GETBREAK,'11,'14,"ISN");
ALIAS_NAME←LOGIN_NAME←NULL;
WHILE NOT REOF DO
α "GETALINE"
STRING PN;
LINE←INPUT(RCHAN,CRBREAK);
PN←SCAN(LINE,TABBREAK,BRCHAR);
IF EQU($ALIAS_ID,PN) THEN ALIAS_NAME←LINE;
IF EQU($LOGIN_ID,PN) THEN LOGIN_NAME←LINE;
β;
RELBREAK(CRBREAK);
RELBREAK(TABBREAK);
RELEASE(RCHAN);
IF ALIAS_NAME THEN $USERNAME←ALIAS_NAME
ELSE IF LOGIN_NAME THEN $USERNAME←LOGIN_NAME
ELSE α
OUTSTR("I haven't met you before, what is your name? ");
$USERNAME←INCHWL;
OUTSTR("Please send a message to MSM that you'd like POINTY to recognize you.
"); β;
β;
PROCEDURE INIINTERRUPT;
BEGIN
intmap(15,esc_I,0); ! set mapping for interrupt handler;
enable(15); ! enable the interrupt handler;
$ESC_I←FALSE;
END;
PROCEDURE INIDISPLAY;
BEGIN
IFC #DISPL THENC INIDPY;ENDC
IFC #DISPL THENC ARRCLR($DISPLAYLIST,NULL); UPDATE;ENDC
END;
BOOLEAN WANT$SYSOUT;
PROCEDURE INIPHOTO;
BEGIN
EXTERNAL INTEGER INIACS;
INTEGER ARRAY F[0:3]; INTEGER I;
STRING FILE;
FOR I←0 STEP 1 UNTIL 3 DO F[I]←MEMORY[LOCATION(INIACS)+I];
FILE←CVXSTR(F[0])&"."&CVXSTR(F[1])[1 TO 3]&"["&CVXSTR(F[3])[1 TO 3]&
","&CVXSTR(F[3])[4 TO 6]&"]";
$SYSFL←"POINTY.PHT[PNT,HE]";
$SYSCH←ORAFILE($SYSFL,
FF&"{"&FILE&" :"&DAT_STR&" ALIAS "&$ALIAS_PPN
&" LOGIN "&$LOGIN_PPN&":"&$USERNAME&"}"&CRLF,FALSE);
IF $SYSCH=-1 THEN
BEGIN PRINT("Terminal session will not be saved on system file",CRLF);
$SYSOUT←FALSE;
END ELSE $SYSOUT←TRUE;
WANT$SYSOUT←$SYSOUT;
END;
SIMPLE PROCEDURE INITTYTYPE;
BEGIN
INTEGER I; STRING J; J←TTYTYPE;
FOR I←MAX_TTY STEP -1 UNTIL 1 DO IF EQU($TTYNAME[I],J) THEN DONE;
$TTYTYPE←I;
END;
! initialization procedure : INIT,INIT0;
INTERNAL PROCEDURE INIT;
BEGIN
$ALLOW←1; ! dont do any displays ;
GETUSERNAME; ! get the user name ;
INIMSG; ! print initial message;
ALINIT;
RESTRT11; ! restart at the starting point;
REASSI(0,"ARM");! makes sure ARM is deassigned if we hit call;
INISCANNER; ! initialize the scanner;
INIOFFSET; ! initialize arroff,varoff,byvar;
INIBRK; ! initialize break tables;
INIDIMENS;
INIWORLD;
CONSTDATA; ! read in constant data;
SETOFFSET(CON_OFFSET);
! remember the current offsets;
SAVRESOFFSET;
GTARMOFFSET; ! keep offsets for arms;
INIERRCODES; ! set up initial values for barm_error, etc ;
TMPOFFSET; ! set up temporary variables;
$ALLOW←0; ! enable displays;
INIINTERRUPT; ! set up interrupts - <esc> I ;
INIDISPLAY; ! initialize display;
INIPHOTO; ! initialize the recording session;
INITTYTYPE; ! find out the terminal type;
INIUSRFILE("PNTIN0.PNT");
oldpcdbuf←getpcdbuf;
END;
REQUIRE INIT INITIALIZATION;
INTERNAL PROCEDURE INIT0;
BEGIN
$ALLOW←1;
GETUSERNAME;
INIMSG;
$ALLOW←0;
END;
! preswap,postswap;
! these two routines are responsible for setting up things before saving
the core image and swapping, and for setting up the i/o channels after
swapping: they should be called only by the swap routine;
INTERNAL PROCEDURE PRESWAP;
BEGIN
! remember which channels are open, close all output files, complain about
input files;
IF $OUT THEN CRAFILE($TTYCH);
IF $SYSOUT THEN CRAFILE($SYSCH);
REASSI(CALL(0,"PJOB"),"ARM"); ! make sure we have the ARM attached to us ;
$USERNAME←$ALIAS_ID←$LOGIN_ID←$ALIAS_PPN←$LOGIN_PPN←NULL;
END;
PROCEDURE REOPENFILES;
BEGIN
! setup desired channels again;
IF $OUT THEN
BEGIN $TTYCH←ORAFILE($TTYFL,"{ continued writing again at "&dat_str&"}"&CRLF,FALSE);
IF $TTYCH=-1 THEN
BEGIN PRINT("WILL DISCONTINUE WRITING IN ",$TTYFL,CRLF);
$OUT←FALSE; END;
END;
IF WANT$SYSOUT THEN
BEGIN
$SYSCH←ORAFILE($SYSFL,"{ continued writing again at "&DAT_STR&"}"&CRLF,FALSE);
IF $SYSCH=-1 THEN
BEGIN IF $SYSOUT THEN PRINT("WILL DISCONTINUE WRITING IN ",$SYSFL,CRLF);
WANT$SYSOUT←$SYSOUT←FALSE;
END;
END;
END;
INTERNAL PROCEDURE POSTSWAP(BOOLEAN SAMECOREIMAGE);
BEGIN
IF SAMECOREIMAGE THEN REOPENFILES
ELSE BEGIN GETUSERNAME; INIPHOTO; INITTYTYPE; END;
INIINTERRUPT;
REASSI(0,"ARM");
ALINIT;
CALL(CVSIX("POINTY"),"SETNAM");
INIUSRFILE("PNTINI.PNT");
END;
! exit procedure: endit;
INTERNAL PROCEDURE ENDIT;
BEGIN
INTEGER HOUR; STRING $HOUR;
IF $SYSOUT THEN
BEGIN
CPRINT($SYSCH,"{exiting at "&DAT_STR,CRLF," $FPMAX=",$FPMAX,CRLF,
" $INTMAX=",$INTMAX,CRLF,
" $PCDMAX=",$PCDMAX,"}",CRLF);
CRAFILE($SYSCH);
END;
IF $OUT THEN BEGIN PRINT("CLOSING FILE ",$TTYFL); CRAFILE($TTYCH); END;
HOUR←GETHOUR;
BRK_N;
IF HOUR<5 THEN $HOUR←"please get some sleep, you've been working late"
ELSE IF HOUR <15 THEN $HOUR←"have a nice day"
ELSE IF HOUR <20 THEN $HOUR←"have a nice evening"
ELSE $HOUR←"good night, and pleasant dreams";
PRINT("Bye,bye, ..."&$USERNAME&"... "&$HOUR,CRLF);
PRINT("Some interesting statistics:.....",CRLF,
"$FPMAX=",$FPMAX,"; $INTMAX=",$INTMAX,";$PCDMAX=",$PCDMAX,CRLF);
REASSI(0,"ARM"); ! to avoid forgetting to deassign;
CALL(1,"EXIT"); ! allow continuation if desired ;
! following code is executed in case user changes his mind and
wants to continue where he left off;
REOPENFILES;
END;
END;